home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0057_Adlib Programming.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  10KB  |  447 lines
  1. {
  2. > Hello, I'm an amateur-programmer and I've got an Adlib Music Card in
  3. > my system (soon to be on a SoundBlaster compatible in my system too).
  4. > The problem is, how can I programm my Adlib in Turbo Pascal ? I don't
  5. > know. I need information sources, units or anything else that can put
  6. > me on the right way. Please help me !!! Everything is welkom !
  7.  
  8.         I think this source will help you.
  9.         Any questions, please, send me a reply.
  10. }
  11.  
  12. unit MusicIO;
  13.  {Contains procedures and function to call to Ad-Lib sound Driver.
  14.  if Sound Driver is not Loaded the system WILL Crash.
  15.  Parameters must be passed backwards since the sound driver is made
  16.  for a C parameter passing sequence.}
  17.  
  18. interface
  19.  
  20.   uses
  21.     DOS;
  22.  
  23.   type
  24.     Instrument = array[1..26] of integer;
  25.  
  26.   var
  27.     GActVoice :word; {Active Voice}
  28.     GT        :array[0..10] of Instrument; {use global variable to keep array
  29. valid}
  30.  
  31.   procedure InitDriver;
  32.   procedure RelTimeStart(TimeNum,TimeDen :integer);
  33.   procedure SetState(State :integer);
  34.   function GetState :boolean;
  35.   procedure SetMode(PercussionMode :integer);
  36.   function SetVolume(VolNum,VolDen,TimeNum,TimeDen :integer) :boolean;
  37.   function SetTempo(Tempo,TimeNum,TimeDen :integer) :boolean;
  38.   procedure SetActVoice(Voice :word);
  39.   function PlayNote(Pitch :integer; LengthNum,LengthDen :word) :boolean;
  40.   function SetTimbre(TimeNum,TimeDen :word) :boolean;
  41.   procedure SetTickBeat(TickBeat :integer);
  42.   procedure DirectNoteOn(Voice :word; Pitch :integer);
  43.   procedure DirectNoteOff(Voice :word);
  44.   procedure DirectTimbre;
  45.   procedure LoadInstrument(FileSpec :string);
  46.   function LoadSong(FileSpec :string) :boolean;
  47.  
  48.  
  49. implementation
  50.  
  51.   {Returns True if file exists; otherwise, it returns False. Closes the file if
  52. it ex  function Exist(fs :string) :boolean;
  53.     var
  54.       f: file;
  55.     begin
  56.       {$I-}
  57.       Assign(f,fs);
  58.       Reset(f);
  59.       Close(f);
  60.       {$I+}
  61.       Exist:=(IOResult=0) and (fs<>'');
  62.     end;
  63.  
  64.  
  65.   procedure InitDriver;
  66.     {Initialize Sound Driver}
  67.     var
  68.       r :registers;
  69.     begin
  70.       r.SI:=0;
  71.  
  72.       Intr(101,r);
  73.     end;
  74.  
  75.   procedure RelTimeStart(TimeNum,TimeDen :integer);
  76.     {Set Relative Time to Start}
  77.     var
  78.       TD,TN :integer;
  79.       r :registers;
  80.     begin
  81.       TD:=TimeDen;
  82.       TN:=TimeNum;
  83.  
  84.       r.SI:=2;
  85.       r.ES:=Seg(TN);
  86.       r.BX:=Ofs(TN);
  87.  
  88.       Intr(101,r);
  89.     end;
  90.  
  91.   procedure SetState(State :integer);
  92.     {Start or Stop a Song}
  93.     var
  94.       r :registers;
  95.     begin
  96.       r.SI:=3;
  97.       r.ES:=Seg(State);
  98.       r.BX:=Ofs(State);
  99.  
  100.       Intr(101,r);
  101.     end;
  102.  
  103.   function GetState :boolean;
  104.     var
  105.       r :registers;
  106.     begin
  107.       r.SI:=4;
  108.       r.ES:=Seg(GetState);
  109.       r.BX:=Ofs(GetState);
  110.  
  111.       Intr(101,r);
  112.  
  113.       GetState:=(r.BP=1);
  114.     end;
  115.  
  116.   procedure SetMode(PercussionMode :integer);
  117.     {Percussion or Melodic Mode}
  118.     var
  119.       r :registers;
  120.     begin
  121.       r.SI:=6;
  122.       r.ES:=Seg(PercussionMode);
  123.       r.BX:=Ofs(PercussionMode);
  124.  
  125.       Intr(101,r);
  126.     end;
  127.  
  128.   function SetVolume(VolNum,VolDen,TimeNum,TimeDen :integer) :boolean;
  129.     var
  130.       TD,TN,VD,VN :word; {To put variables values in proper order in memory}
  131.       r           :registers;
  132.     begin
  133.       TD:=TimeDen;
  134.       TN:=TimeNum;
  135.       VD:=VolDen;
  136.       VN:=VolNum;
  137.  
  138.       r.SI:=8;
  139.       r.ES:=Seg(VN);
  140.       r.BX:=Ofs(VN);
  141.  
  142.       Intr(101,r);
  143.  
  144.       SetVolume:=(r.BP=1);
  145.     end;
  146.  
  147.   function SetTempo(Tempo,TimeNum,TimeDen :integer) :boolean;
  148.     var
  149.       TD,TN,TP :integer; {To put variables values in proper order in memory}
  150.       r        :registers;
  151.     begin
  152.       TD:=TimeDen;
  153.       TN:=TimeNum;
  154.       TP:=Tempo;
  155.  
  156.       r.SI:=9;
  157.       r.ES:=Seg(TP);
  158.       r.BX:=Ofs(TP);
  159.  
  160.       Intr(101,r);
  161.  
  162.       SetTempo:=(r.BP=1);
  163.     end;
  164.  
  165.   procedure SetActVoice(Voice :word);
  166.     var
  167.       r :registers;
  168.     begin
  169.       GActVoice:=Voice;
  170.  
  171.       r.SI:=12;
  172.       r.ES:=Seg(Voice);
  173.       r.BX:=Ofs(Voice);
  174.  
  175.       Intr(101,r);
  176.     end;
  177.  
  178.   function PlayNoteDel(Pitch :integer; LengthNum,LengthDen,DelayNum,DelayDen
  179. :word) :    var
  180.       DD,DN,LD,LN :word;
  181.       P           :integer;
  182.       r           :registers;
  183.     begin
  184.       P:=Pitch;
  185.       LD:=LengthDen;
  186.       LN:=LengthNum;
  187.       DN:=DelayNum;
  188.       DD:=DelayDen;
  189.  
  190.       r.SI:=14;
  191.       r.ES:=Seg(P);
  192.       r.BX:=Ofs(P);
  193.  
  194.       Intr(101,r);
  195.  
  196.       PlayNoteDel:=(r.BP=1);
  197.     end;
  198.  
  199.   function PlayNote(Pitch :integer; LengthNum,LengthDen :word) :boolean;
  200.     var
  201.       LD,LN :word;
  202.       P     :integer;
  203.       r     :registers;
  204.     begin
  205.       P:=Pitch;
  206.       LD:=LengthDen;
  207.       LN:=LengthNum;
  208.  
  209.       r.SI:=15;
  210.       r.ES:=Seg(P);
  211.       r.BX:=Ofs(P);
  212.  
  213.       Intr(101,r);
  214.  
  215.       PlayNote:=(r.BP=1);
  216.     end;
  217.  
  218.   function SetTimbre(TimeNum,TimeDen :word) :boolean;
  219.     var
  220.       TD,TN :word;
  221.       T     :^integer;
  222.       c1,c2 :byte;
  223.       r     :registers;
  224.     begin
  225.       T:=Addr(GT[GActVoice]);
  226.       TN:=TimeNum;
  227.       TD:=TimeDen;
  228.  
  229.       r.SI:=16;
  230.       r.ES:=Seg(T);
  231.       r.BX:=Ofs(T);
  232.  
  233.       Intr(101,r);
  234.  
  235.       SetTimbre:=(r.BP=1);
  236.     end;
  237.  
  238.   function SetPitch(DeltaOctave,DeltaNum,DeltaDen :integer; TimeNum,TimeDen
  239. :word) :b    var
  240.       TD,TN   :word;
  241.       DD,DN,D :integer;
  242.       c1,c2   :byte;
  243.       r       :registers;
  244.     begin
  245.       D:=DeltaOctave;
  246.       DN:=DeltaNum;
  247.       DD:=DeltaDen;
  248.       TN:=TimeNum;
  249.       TD:=TimeDen;
  250.  
  251.       r.SI:=16;
  252.       r.ES:=Seg(D);
  253.       r.BX:=Ofs(D);
  254.  
  255.       Intr(101,r);
  256.  
  257.       SetPitch:=(r.BP=1);
  258.     end;
  259.  
  260.   procedure SetTickBeat(TickBeat :integer);
  261.     var
  262.       r :registers;
  263.     begin
  264.       r.SI:=18;
  265.       r.ES:=Seg(TickBeat);
  266.       r.BX:=Ofs(TickBeat);
  267.  
  268.       Intr(101,r);
  269.     end;
  270.  
  271.   procedure DirectNoteOn(Voice :word; Pitch :integer);
  272.     var
  273.       P :integer;
  274.       V :word;
  275.       r :registers;
  276.     begin
  277.       P:=Pitch;
  278.       V:=Voice;
  279.  
  280.       r.SI:=19;
  281.       r.ES:=Seg(V);
  282.       r.BX:=Ofs(V);
  283.  
  284.       Intr(101,r);
  285.     end;
  286.  
  287.   procedure DirectNoteOff(Voice :word);
  288.     var
  289.       r :registers;
  290.     begin
  291.       r.SI:=20;
  292.       r.ES:=Seg(Voice);
  293.       r.BX:=Ofs(Voice);
  294.  
  295.       Intr(101,r);
  296.     end;
  297.  
  298.   procedure DirectTimbre;
  299.     var
  300.       T     :^integer;
  301.       V     :word;
  302.       r     :registers;
  303.     begin
  304.       V:=GActVoice;
  305.       T:=Addr(GT[V]);
  306.  
  307.       r.SI:=21;
  308.       r.ES:=Seg(V);
  309.       r.BX:=Ofs(V);
  310.  
  311.       Intr(101,r);
  312.     end;
  313.  
  314.   procedure LoadInstrument(FileSpec :string);
  315.     {Load an Instument from Disk and Place in Array}
  316.     var
  317.       c1 :byte;
  318.       n  :integer;
  319.       f  :file of integer;
  320.     begin
  321.       if not(Exist(FileSpec)) then FileSpec:='C:\MUSIC\PIANO1.INS';
  322.       Assign(f,FileSpec);
  323.       Reset(f);
  324.       Read(f,n);
  325.       for c1:=1 to 26 do
  326.         Read(f,GT[GActVoice,c1]);
  327.       Close(f);
  328.     end;
  329.  
  330.   function LoadSong;
  331.     {Read a .ROL file and place song in Buffer}
  332.     var
  333.       nb :byte;
  334.       ns :string[255];
  335.       ni,ni2,ni3,ni4,BPM :integer;
  336.       c1,c2  :word;
  337.       nr,nr2 :real;
  338.       fl :boolean;
  339.       f  :file;
  340.     procedure StringRead(len :word); {uses f,ns}
  341.       var
  342.         nc :char;
  343.         c1 :word;
  344.       begin
  345.         ns:='';
  346.         for c1:=1 to len do
  347.           begin
  348.             BlockRead(f,nc,1);
  349.             ns:=ConCat(ns,nc);
  350.           end;
  351.       end;
  352.     procedure TempoRead; {uses f,nb}
  353.       var
  354.         b1,b2,b3,b4 :byte;
  355.       begin
  356.         BlockRead(f,b1,1);
  357.         BlockRead(f,b2,1);
  358.         BlockRead(f,b3,1);
  359.         BlockRead(f,b4,1);
  360.         nb:=(b3{ div 2});
  361.       end;
  362.     procedure VolumeRead;
  363.       var
  364.         b1,b2,b3,b4 :byte;
  365.       begin
  366.         BlockRead(f,b1,1);
  367.         BlockRead(f,b2,1);
  368.         BlockRead(f,b3,1);
  369.         BlockRead(f,b4,1);
  370.         nb:=51+Round(b3/2.5);
  371.       end;
  372.     begin
  373.       LoadSong:=true;
  374.       if not(Exist(FileSpec))
  375.         then begin
  376.                LoadSong:=false;
  377.                Exit;
  378.              end;
  379.  
  380.       InitDriver;
  381.       RelTimeStart(0,1);
  382.       Assign(f,FileSpec);
  383.       Reset(f,1);
  384.       StringRead(44);
  385.       BlockRead(f,ni,2); SetTickBeat(ni); {Ticks per Beat}
  386.       BlockRead(f,ni,2); BPM:=ni; {Beats per Measure}
  387.       StringRead(5);
  388.       BlockRead(f,nb,1); SetMode(1); {Mode}
  389.       StringRead(143);
  390.       TempoRead; fl:=SetTempo(nb,0,1); {Tempo}
  391.       BlockRead(f,ni,2);
  392.       for c1:=1 to ni do
  393.         begin
  394.           BlockRead(f,ni2,2);
  395.           TempoRead; fl:=SetTempo(nb,ni2,1); {Tempo}
  396.         end;
  397.       for c1:=0 to 10 do {11 Voices}
  398.         begin
  399.           SetActVoice(c1);
  400.           StringRead(15);
  401.           BlockRead(f,ni2,2); {Time in ticks of last Note}
  402.           c2:=0;
  403.           while (c2<ni2) do
  404.             begin
  405.               BlockRead(f,ni3,2); {Note Pitch}
  406.               BlockRead(f,ni4,2); {Note Duration}
  407.               fl:=PlayNote(ni3-60,ni4,BPM); {Note}
  408.               c2:=c2+ni4; {Summation of Durations}
  409.             end;
  410.           StringRead(15);
  411.           BlockRead(f,ni2,2);
  412.           for c2:=1 to ni2 do {Instuments}
  413.             begin
  414.               BlockRead(f,ni3,2);
  415.               StringRead(9);
  416.               nb:=Pos(#0,ns);
  417.               Delete(ns,nb,Length(ns));
  418.               LoadInstrument(ConCat('C:\MUSIC\',ns,'.INS'));
  419.               fl:=SetTimbre(ni3,1);
  420.               StringRead(1);
  421.               BlockRead(f,ni4,2);
  422.             end;
  423.           StringRead(15);
  424.           BlockRead(f,ni2,2);
  425.           nb:=1;
  426.           for c2:=1 to ni2 do {Volume}
  427.             begin
  428.               BlockRead(f,ni3,2);
  429.               fl:=SetVolume(100,nb,ni3,1); {Use inverse to disable Relative}
  430.               VolumeRead;
  431.               fl:=SetVolume(nb,100,ni3,1);
  432.             end;
  433.           StringRead(15);
  434.           BlockRead(f,ni2,2);
  435.           for c2:=1 to ni2 do {Pitch -disabled}
  436.             begin
  437.               BlockRead(f,ni3,2);
  438.               BlockRead(f,nr,4);
  439.               if (nr=0) then nr2:=1 else nr2:=nr;
  440. {             fl:=SetPitch(0,Abs(Trunc(nr*100)),Trunc((nr/nr2)*100),ni3,1);}
  441.             end;
  442.         end;
  443.       Close(f);
  444.     end;
  445.  
  446. end.
  447.